Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Pascal/Libraries/DBL Pascal Library/DefProcs/ICON Cntl/IconCDEF.p

Text File | 1992-10-02 | 8.2 KB | 256 lines | [TEXT/PJMM]

unit IconCDEF;

{David B. Lamkins, June 1991}

{This is a CDEF for a momentary-action icon button that provides the following features:}
{    • Uses control title, rather than a separate dialog item or control title.}
{    • Handles “showTitle” variant (CDEF ID*16+1) to display control title centered under icon.}
{    • Handles “useWFont” variant (CDEF ID*16+8) to display title using window font.}
{    • Recognizes HiliteControl to enable/disable button.}
{}
{Use:}
{    CNTL min = ICON resource ID for control value 0.}
{    CNTL max = ICON resource ID for control value 1.}
{    CNTL title = title to display for showTitle variant.}
{    CNTL proc ID = 96, 97, 104, or 105 (since this is CDEF 6).}
{    CNTL refcon is unused.}
{    DITL rect must be at least as large as CNTL rect, otherwise Dialog Mgr won't detect hit in control.}
{    You can not use SetCtlMin and SetCtlMax to change the icons on the fly…}
{    Calling SetCtlValue changes the displayed icon.}
{    If the dialog contains TE fields, “useWFont” requires special handling. The following is}
{      derived from Apple's Q&A Stack:}
{            theDialog := GetNewDialog(…);}
{            SetPort(theDialog);}
{            TextFont(…);}
{            TextSize(…);}
{            ShowWindow(theDialog);}
{            for i := 1 to 3 do}
{                if EventAvail(everyEvent, evt) then}
{                    ;}
{            with DialogPeek(theDialog)^.textH^^ do}
{                begin}
{                    txFont := theDialog^.txFont;}
{                    txSize := theDialog^.txSize;}
{                end;}
{            InitCursor;}
{            repeat}
{                ModalDialog(…);}
{                …}
{            until …;}
{            DisposDialog(theDialog);}

interface

    function main (varCode: Integer; theControl: ControlHandle; message: Integer; param: Longint): Longint;

implementation

{$SETC Debugging=False}

    function main;
        const
            calcCntlRgn = 10;        {new in System 6.x and 7.0}
            calcThumbRgn = 11;    {new in System 6.x and 7.0}
            titleInset = 1;
            showTitle = 1;            {variant code}
            partCode = 1;            {our part code}

        type
            PrivateData = record
                    icon0: Handle;        {the 0-state icon}
                    icon1: Handle;        {the 1-state icon}
                    patGrey: Pattern;    {our own grey pattern - can't use globals}
                    ourRgn: RgnHandle;    {the control's region for tracking hits}
                end;
            DataPtr = ^PrivateData;
            DataHandle = ^DataPtr;

        var
            savePort: GrafPtr;        {original port during drawing}
            saveFont: Integer;        {original font}
            saveSize: Integer;        {original size}
            saveFace: Style;        {original style}
            centerLine: Integer;    {vertical center line of icon}
            titleWidth: Integer;        {width of the title}
            titleRect: Rect;            {bounding rect of the title}
            textBaseline: Integer;    {vertical position of title}
            info: FontInfo;            {font info for drawing title}

    begin {Main — Icon Button CDEF}
        main := 0;        {we normally return a zero}
        HLock(Handle(theControl));    {lock down the control data for the duration}
        with theControl^^ do
            begin

        {----- Initialization -----}
                if message = initCntl then
                    begin
{$IFC Debugging}
                        DebugStr('initCntl');
{$ENDC}
                        contrlData := NewHandleClear(SIZEOF(PrivateData));    {allocate private storage}
                        if contrlData <> nil then
                            begin
                                HLock(contrlData);
                                with DataHandle(contrlData)^^ do
                                    begin    {create our local bitmap data}
                                        StuffHex(@patGrey, 'AA55AA55AA55AA55');
                                        icon0 := GetIcon(contrlMin);    {get handles to our icons}
                                        icon1 := GetIcon(contrlMax);
                                        ourRgn := NewRgn;    {create a region to hold button/title outline}
                                    end;
                                HUnLock(contrlData);
                            end;
                    end

        {----- Disposal -----}
                else if message = dispCntl then
                    begin
{$IFC Debugging}
                        DebugStr('dispCntl');
{$ENDC}
            {Don't know who else might be using our ICONs, so leave them alone.}
                        if contrlData <> nil then
                            begin
                                DisposeRgn(DataHandle(contrlData)^^.ourRgn);    {done forever with this region}
                                DisposHandle(contrlData);    {don't need our local data anymore, either}
                            end;
                    end

                else if contrlData <> nil then
                    begin
                        HLock(contrlData);    {lock down control's private data}
                        with DataHandle(contrlData)^^ do
                            case message of

        {----- Drawing -----}
                                drawCntl:
                                    begin
{$IFC Debugging}
                                        DebugStr('drawCntl');
{$ENDC}
                                        GetPort(savePort);    {make sure we have the right port}
                                        SetPort(contrlOwner);
                                        with contrlOwner^ do    {remember the original font}
                                            begin
                                                saveFont := txFont;
                                                saveSize := txSize;
                                                saveFace := txFace;
                                            end;
                                        if BAND(varCode, useWFont) = 0 then        {if we need system font, set it}
                                            begin
                                                TextSize(0);
                                                TextFont(0);
                                            end;
                                        TextFace([]);    {make sure we have a clean face}
                                        GetFontInfo(info);    {measure the title}
{$PUSH}
{$R-}
                                        titleWidth := TextWidth(@contrlTitle[1], 0, ORD(contrlTitle[0]));
{$POP}
                                        with contrlRect do
                                            begin    {force the control rect to fit an icon}
                                                bottom := top + 32;
                                                right := left + 32;
                                                centerLine := left + 16;
                                            end;
                                        with info, titleRect do
                                            begin    {position the control title and establish its bounding rect}
                                                top := contrlRect.bottom;
                                                bottom := top + ascent + descent + leading;
                                                left := centerLine - titleWidth div 2;
                                                right := left + titleWidth;
                                                textBaseline := bottom - descent;
                                            end;
                                        InsetRect(titleRect, -titleInset, 0);
                                        OpenRgn;    {make our region include the icon and the label}
                                        FrameRect(contrlRect);
                                        if BAND(varCode, showTitle) <> 0 then
                                            FrameRect(titleRect);
                                        CloseRgn(ourRgn);    {save the control's region for future reference}
                                        if contrlValue < 0 then    {make sure our control value is legitimate}
                                            contrlValue := 0
                                        else if contrlValue > 1 then
                                            contrlValue := 1;
                                        if contrlVis <> 0 then {if the control is visible…}
                                            if (icon0 <> nil) and (icon1 <> nil) then    {…and both icons are present…}
                                                begin    {draw the control}
                                                    LoadResource(icon0);    {what if ICONs were purged?}
                                                    LoadResource(icon1);
                                                    if BAND(varCode, showTitle) <> 0 then
                                                        begin    {draw the title}
                                                            EraseRect(titleRect);
                                                            MoveTo(titleRect.left + titleInset, textBaseline);
                                                            DrawString(contrlTitle);
                                                        end;
                                                    case contrlHilite of
                                                        0, 255:    {display normal control}
                                                            case contrlValue of
                                                                0:
                                                                    PlotIcon(contrlRect, icon0);
                                                                1:
                                                                    PlotIcon(contrlRect, icon1);
                                                            end;
                                                        1:     {display active control}
                                                            begin
                                                                if BAND(varCode, showTitle) <> 0 then
                                                                    InvertRect(titleRect);    {hilite the title}
                                                                case contrlValue of    {display “pressed” icon}
                                                                    0:
                                                                        PlotIcon(contrlRect, icon1);
                                                                    1:
                                                                        PlotIcon(contrlRect, icon0);
                                                                end;
                                                            end;
                                                    end;
                                                    if contrlHilite = 255 then
                                                        begin    {grey out disabled control}
                                                            PenPat(patGrey);
                                                            PenMode(patBic);
                                                            PaintRect(contrlRect);
                                                            PaintRect(titleRect);
                                                        end;
                                                end
                                            else
                                                begin    {no icon? draw a blank…}
                                                    PenPat(patGrey);
                                                    PaintRect(contrlRect);
                                                end;
                                        TextFont(saveFont);    {set everything back the way it was}
                                        TextSize(saveSize);
                                        TextFace(saveFace);
                                        SetPort(savePort);
                                    end;

        {----- Testing -----}
                                testCntl:
                                    begin
{$IFC Debugging}
                                        DebugStr('testCntl');
{$ENDC}
                                        if (contrlHilite <> 255) and PtInRgn(Point(param), ourRgn) then
                                            main := partCode;    {hit our control}
                                    end;

        {----- Regions -----}
                                calcCRgns, calcCntlRgn:
                                    begin
{$IFC Debugging}
                                        DebugStr('calcCRgns, calcCntlRgn');
{$ENDC}
                                        if (message <> calcCRgns) or not BTST(param, 31) then
                                            CopyRgn(ourRgn, RgnHandle(param));    {return control region}
                                    end;

                                otherwise
                                    ;    {don't handle other messages}

                            end;
                        HUnLock(contrlData);
                    end;
            end;
        HUnLock(Handle(theControl));
    end;


end.